!#include  "PPR.INC"

! ************************************************************************
!c exchanges*******************************************************
!c exchanges*******************************************************
!c exchanges*******************************************************
!c exchanges*******************************************************
!c exchanges*******************************************************
!C----------------- SUBROUTINES FOR PARALLEL EXCHANGES -------------------
!#if parallel

!c*************************************************************************


        SUBROUTINE MPA_EXCH_NEW(x,nxi,nxe,nyi,nye,nzi,nze, &
     &                      nxsi,nxse,nysi,nyse,nzsi,nzse, &
     &                      nxmin,nxmax,nymin,nymax,nzmin,nzmax, &   
     &                      nxsh,nysh,nzsh,identif, &
     &                      comm3d,req,nproc,ndim, &
     &                      prplc,request_send,request_recv, &
     &                      maxshift)

       implicit none

       include 'mpif.h'

       integer identif
       integer comm3d,myrank,ierr,nproc,itag,iitag,ntag
       integer nx,ny,nz,nxi,nxe,nyi,nye,nzi,nze,i,j,k,is,js,ks
       integer nxsi,nxse,nysi,nyse,nzsi,nzse
       integer nxmin,nxmax,nymin,nymax,nzmin,nzmax
       integer nxsh,nysh,nzsh
       integer nxir,nxer,nyir,nyer,nzir,nzer
       integer lbuf,ibuf,tag,rrank
       integer req(52,2000),req1(1000)
       integer status(MPI_STATUS_SIZE,52)
       integer status1(MPI_STATUS_SIZE)
       integer ndim
       logical isperiodic(3),isperiodic1(3)
       integer dims(3),coords(3),coordn(3)
       integer testrank
       integer ireq
       integer ic
       integer prplc(26)
       integer(4), intent(in) :: maxshift
       integer, intent(inout) :: request_send(1:maxshift,1:26)
       integer, intent(inout) :: request_recv(1:maxshift,1:26)
       integer, save :: req_recv_num(1:26)
       integer :: &
     &    irxpy0z0,irxmy0z0,irx0ypz0,irx0ymz0, &
     &    irx0y0zp,irx0y0zm,irxpypz0, &
     &    irxmypz0,irxpymz0,irxmymz0,irxpy0zp, &
     &    irxpy0zm,irxmy0zp,irxmy0zm, &
     &    irx0ypzp,irx0ypzm,irx0ymzp,irx0ymzm, &
     &    irxpypzp,irxpymzp,irxpypzm, &
     &    irxpymzm,irxmypzp,irxmymzp,irxmypzm,irxmymzm
       logical ans,flag
       logical, save :: ansar(1:26)
       logical, save :: firstcall = .true.
       logical :: MPA_BCHK
       real(kind=8) x(nxsi:nxse,nysi:nyse,nzsi:nzse)


       INTEGER IFN,IFK
       character(len=3) fn

       REAL(kind=8), allocatable, save :: xpy0z0(:),rxpy0z0(:)
       REAL(kind=8), allocatable, save :: x0ypz0(:),rx0ypz0(:)
       REAL(kind=8), allocatable, save :: x0y0zp(:),rx0y0zp(:)
       REAL(kind=8), allocatable, save :: xmy0z0(:),rxmy0z0(:)
       REAL(kind=8), allocatable, save :: x0ymz0(:),rx0ymz0(:)
       REAL(kind=8), allocatable, save :: x0y0zm(:),rx0y0zm(:)
       REAL(kind=8), allocatable, save :: xpypz0(:),rxpypz0(:)
       REAL(kind=8), allocatable, save :: xpymz0(:),rxpymz0(:)
       REAL(kind=8), allocatable, save :: xmypz0(:),rxmypz0(:)
       REAL(kind=8), allocatable, save :: xmymz0(:),rxmymz0(:)
       REAL(kind=8), allocatable, save :: xpy0zp(:),rxpy0zp(:)
       REAL(kind=8), allocatable, save :: xpy0zm(:),rxpy0zm(:)
       REAL(kind=8), allocatable, save :: xmy0zp(:),rxmy0zp(:)
       REAL(kind=8), allocatable, save :: xmy0zm(:),rxmy0zm(:)
       REAL(kind=8), allocatable, save :: x0ypzp(:),rx0ypzp(:)
       REAL(kind=8), allocatable, save :: x0ypzm(:),rx0ypzm(:)
       REAL(kind=8), allocatable, save :: x0ymzp(:),rx0ymzp(:)
       REAL(kind=8), allocatable, save :: x0ymzm(:),rx0ymzm(:)
       REAL(kind=8), allocatable, save :: xpypzp(:),rxpypzp(:)
       REAL(kind=8), allocatable, save :: xpymzp(:),rxpymzp(:)
       REAL(kind=8), allocatable, save :: xpypzm(:),rxpypzm(:)
       REAL(kind=8), allocatable, save :: xpymzm(:),rxpymzm(:)
       REAL(kind=8), allocatable, save :: xmypzp(:),rxmypzp(:)
       REAL(kind=8), allocatable, save :: xmymzp(:),rxmymzp(:)
       REAL(kind=8), allocatable, save :: xmypzm(:),rxmypzm(:)
       REAL(kind=8), allocatable, save :: xmymzm(:),rxmymzm(:)

       data req_recv_num &
       & /2,1,4,3,6,5,10,9,8,7,14,13,12,11,18,17,16,15,26,25,24,23,22,21,20,19/

      if (firstcall) then

!     The buffer sizes are set to maximal possible values

      lbuf = (nzmax-nzmin+1)*(nymax-nymin+1)*maxshift !nxsh
      allocate(xpy0z0(lbuf))
      allocate(xmy0z0(lbuf))
      allocate(rxpy0z0(lbuf))
      allocate(rxmy0z0(lbuf))
      lbuf = (nzmax-nzmin+1)*(nxmax-nxmin+1)*maxshift !nysh
      allocate(x0ypz0(lbuf))
      allocate(x0ymz0(lbuf))
      allocate(rx0ypz0(lbuf))
      allocate(rx0ymz0(lbuf))

      lbuf = (nymax-nymin+1)*(nxmax-nxmin+1)*maxshift !nzsh
      allocate(x0y0zp(lbuf))
      allocate(x0y0zm(lbuf))
      allocate(rx0y0zp(lbuf))
      allocate(rx0y0zm(lbuf))

      lbuf = (nzmax-nzmin+1)*maxshift*maxshift !nysh*nxsh
      allocate (xpypz0(lbuf))
      allocate (rxpypz0(lbuf))
      allocate (xpymz0(lbuf))
      allocate (rxpymz0(lbuf))
      allocate (xmypz0(lbuf))
      allocate (rxmypz0(lbuf))
      allocate (xmymz0(lbuf))
      allocate (rxmymz0(lbuf))

      lbuf = (nymax-nymin+1)*maxshift*maxshift !nzsh*nxsh
      allocate (xpy0zp(lbuf))
      allocate (rxpy0zp(lbuf))
      allocate (xpy0zm(lbuf))
      allocate (rxpy0zm(lbuf))
      allocate (xmy0zp(lbuf))
      allocate (rxmy0zp(lbuf))
      allocate (xmy0zm(lbuf))
      allocate (rxmy0zm(lbuf))

      lbuf = (nxmax-nxmin+1)*maxshift*maxshift !nzsh*nysh
      allocate (x0ypzp(lbuf))
      allocate (rx0ypzp(lbuf))
      allocate (x0ypzm(lbuf))
      allocate (rx0ypzm(lbuf))
      allocate (x0ymzp(lbuf))
      allocate (rx0ymzp(lbuf))
      allocate (x0ymzm(lbuf))
      allocate (rx0ymzm(lbuf))

      lbuf = maxshift*maxshift*maxshift !nxsh*nzsh*nysh
      allocate (xpypzp(lbuf))
      allocate (rxpypzp(lbuf))
      allocate (xpymzp(lbuf))
      allocate (rxpymzp(lbuf))
      allocate (xpypzm(lbuf))
      allocate (rxpypzm(lbuf))
      allocate (xpymzm(lbuf))
      allocate (rxpymzm(lbuf))
      allocate (xmypzp(lbuf))
      allocate (rxmypzp(lbuf))
      allocate (xmymzp(lbuf))
      allocate (rxmymzp(lbuf))
      allocate (xmypzm(lbuf))
      allocate (rxmypzm(lbuf))
      allocate (xmymzm(lbuf))
      allocate (rxmymzm(lbuf))

      endif

       ireq = 0

       isperiodic1(1) = .false.
       isperiodic1(2) = .false.
       isperiodic1(3) = .false.

!       call MPI_BARRIER(COMM3D,ierr)

       call MPI_COMM_RANK(comm3d,myrank,ierr)

       call MPI_CART_GET(comm3d, ndim, dims, isperiodic, coords,ierr)

!      sending boundary points
!
!      x-shift send
!
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
       if (firstcall) then

         coordn(1)=coords(1)+1
         coordn(2)=coords(2)
         coordn(3)=coords(3)
         ansar(1)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(1)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf = (nzmax-nzmin+1)*(nymax-nymin+1)*i
             call MPI_SEND_INIT(xpy0z0, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,1), ierr)
             call MPI_RECV_INIT(rxmy0z0, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(1)), ierr)
           enddo
         endif

         coordn(1)=coords(1)-1
         coordn(2)=coords(2)
         coordn(3)=coords(3)
         ansar(2)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(2)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf = (nzmax-nzmin+1)*(nymax-nymin+1)*i
             call MPI_SEND_INIT(xmy0z0, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,2), ierr)
             call MPI_RECV_INIT(rxpy0z0, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(2)), ierr)
           enddo
         endif

         coordn(2)=coords(2)+1
         coordn(1)=coords(1)
         coordn(3)=coords(3)
         ansar(3)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(3)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=(nzmax-nzmin+1)*(nxmax-nxmin+1)*i
             call MPI_SEND_INIT(x0ypz0, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,3), ierr)
             call MPI_RECV_INIT(rx0ymz0, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(3)), ierr)
           enddo
         endif

         coordn(2)=coords(2)-1
         coordn(1)=coords(1)
         coordn(3)=coords(3)
         ansar(4)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(4)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=(nzmax-nzmin+1)*(nxmax-nxmin+1)*i
             call MPI_SEND_INIT(x0ymz0, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,4), ierr)
             call MPI_RECV_INIT(rx0ypz0, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(4)), ierr)
           enddo
         endif

         coordn(3)=coords(3)+1
         coordn(1)=coords(1)
         coordn(2)=coords(2)
         ansar(5)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(5)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=(nymax-nymin+1)*(nxmax-nxmin+1)*i
             call MPI_SEND_INIT(x0y0zp, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,5), ierr)
             call MPI_RECV_INIT(rx0y0zm, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(5)), ierr)
           enddo
         endif

         coordn(3)=coords(3)-1
         coordn(1)=coords(1)
         coordn(2)=coords(2)
         ansar(6)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(6)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=(nymax-nymin+1)*(nxmax-nxmin+1)*i
             call MPI_SEND_INIT(x0y0zm, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,6), ierr)
             call MPI_RECV_INIT(rx0y0zm, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(6)), ierr)
           enddo
         endif

         coordn(1)=coords(1)+1
         coordn(2)=coords(2)+1
         coordn(3)=coords(3)
         ansar(7)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(7)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=(nzmax-nzmin+1)*maxshift*maxshift
             call MPI_SEND_INIT(xpypz0, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,7), ierr)
             call MPI_RECV_INIT(rxmymz0, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(7)), ierr)
           enddo
         endif

         coordn(1)=coords(1)+1
         coordn(2)=coords(2)-1
         coordn(3)=coords(3)
         ansar(8)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(8)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=(nzmax-nzmin+1)*maxshift*maxshift
             call MPI_SEND_INIT(xpymz0, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,8), ierr)
             call MPI_RECV_INIT(rxmypz0, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(8)), ierr)
           enddo
         endif

         coordn(1)=coords(1)-1
         coordn(2)=coords(2)+1
         coordn(3)=coords(3)
         ansar(9)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(9)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=(nzmax-nzmin+1)*maxshift*maxshift
             call MPI_SEND_INIT(xmypz0, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,9), ierr)
             call MPI_RECV_INIT(rxpymz0, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(9)), ierr)
           enddo
         endif

         coordn(1)=coords(1)-1
         coordn(2)=coords(2)-1
         coordn(3)=coords(3)
         ansar(10)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(10)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=(nzmax-nzmin+1)*maxshift*maxshift
             call MPI_SEND_INIT(xmymz0, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,10), ierr)
             call MPI_RECV_INIT(rxpypz0, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(10)), ierr)
           enddo
         endif

         coordn(1)=coords(1)+1
         coordn(3)=coords(3)+1
         coordn(2)=coords(2)
         ansar(11)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(11)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=(nymax-nymin+1)*maxshift*maxshift
             call MPI_SEND_INIT(xpy0zp, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,11), ierr)
             call MPI_RECV_INIT(rxmy0zm, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(11)), ierr)
           enddo
         endif

         coordn(1)=coords(1)+1
         coordn(3)=coords(3)-1
         coordn(2)=coords(2)
         ansar(12)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(12)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=(nymax-nymin+1)*maxshift*maxshift
             call MPI_SEND_INIT(xpy0zm, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,12), ierr)
             call MPI_RECV_INIT(rxmy0zp, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(12)), ierr)
           enddo
         endif

         coordn(1)=coords(1)-1
         coordn(3)=coords(3)+1
         coordn(2)=coords(2)
         ansar(13)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(13)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=(nymax-nymin+1)*maxshift*maxshift
             call MPI_SEND_INIT(xmy0zp, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,13), ierr)
             call MPI_RECV_INIT(rxpy0zm, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(13)), ierr)
           enddo
         endif

         coordn(1)=coords(1)-1
         coordn(3)=coords(3)-1
         coordn(2)=coords(2)
         ansar(14)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(14)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=(nymax-nymin+1)*maxshift*maxshift
             call MPI_SEND_INIT(xmy0zm, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,14), ierr)
             call MPI_RECV_INIT(rxpy0zp, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(14)), ierr)
           enddo
         endif

         coordn(2)=coords(2)+1
         coordn(3)=coords(3)+1
         coordn(1)=coords(1)
         ansar(15)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(15)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=(nxmax-nxmin+1)*maxshift*maxshift
             call MPI_SEND_INIT(x0ypzp, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,15), ierr)
             call MPI_RECV_INIT(rx0ymzm, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(15)), ierr)
           enddo
         endif

         coordn(2)=coords(2)+1
         coordn(3)=coords(3)-1
         coordn(1)=coords(1)
         ansar(16)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(16)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=(nxmax-nxmin+1)*maxshift*maxshift
             call MPI_SEND_INIT(x0ypzm, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,16), ierr)
             call MPI_RECV_INIT(rx0ymzp, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(16)), ierr)
           enddo
         endif

         coordn(2)=coords(2)-1
         coordn(3)=coords(3)+1
         coordn(1)=coords(1)
         ansar(17)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(17)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=(nxmax-nxmin+1)*maxshift*maxshift
             call MPI_SEND_INIT(x0ymzp, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,17), ierr)
             call MPI_RECV_INIT(rx0ypzm, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(17)), ierr)
           enddo
         endif

         coordn(2)=coords(2)-1
         coordn(3)=coords(3)-1
         coordn(1)=coords(1)
         ansar(18)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(18)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=(nxmax-nxmin+1)*maxshift*maxshift
             call MPI_SEND_INIT(x0ymzm, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,18), ierr)
             call MPI_RECV_INIT(rx0ypzp, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(18)), ierr)
           enddo
         endif

         coordn(1)=coords(1)+1
         coordn(2)=coords(2)+1
         coordn(3)=coords(3)+1
         ansar(19)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(19)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=maxshift*maxshift*maxshift
             call MPI_SEND_INIT(xpypzp, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,19), ierr)
             call MPI_RECV_INIT(rxmymzm, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(19)), ierr)
           enddo
         endif

         coordn(1)=coords(1)+1
         coordn(2)=coords(2)+1
         coordn(3)=coords(3)-1
         ansar(20)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(20)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=maxshift*maxshift*maxshift
             call MPI_SEND_INIT(xpypzm, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,20), ierr)
             call MPI_RECV_INIT(rxmymzp, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(20)), ierr)
           enddo
         endif

         coordn(1)=coords(1)+1
         coordn(2)=coords(2)-1
         coordn(3)=coords(3)+1
         ansar(21)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(21)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=maxshift*maxshift*maxshift
             call MPI_SEND_INIT(xpymzp, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,21), ierr)
             call MPI_RECV_INIT(rxmypzm, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(21)), ierr)
           enddo
         endif

         coordn(1)=coords(1)+1
         coordn(2)=coords(2)-1
         coordn(3)=coords(3)-1
         ansar(22)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(22)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=maxshift*maxshift*maxshift
             call MPI_SEND_INIT(xpymzm, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,22), ierr)
             call MPI_RECV_INIT(rxmypzp, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(22)), ierr)
           enddo
         endif

         coordn(1)=coords(1)-1
         coordn(2)=coords(2)+1
         coordn(3)=coords(3)+1
         ansar(23)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(23)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=maxshift*maxshift*maxshift
             call MPI_SEND_INIT(xmypzp, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,23), ierr)
             call MPI_RECV_INIT(rxpymzm, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(23)), ierr)
           enddo
         endif

         coordn(1)=coords(1)-1
         coordn(2)=coords(2)+1
         coordn(3)=coords(3)-1
         ansar(24)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(24)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=maxshift*maxshift*maxshift
             call MPI_SEND_INIT(xmypzm, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,24), ierr)
             call MPI_RECV_INIT(rxpymzp, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(24)), ierr)
           enddo
         endif

         coordn(1)=coords(1)-1
         coordn(2)=coords(2)-1
         coordn(3)=coords(3)+1
         ansar(25)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh)
         if (ansar(25)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=maxshift*maxshift*maxshift
             call MPI_SEND_INIT(xmymzp, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,25), ierr)
             call MPI_RECV_INIT(rxpypzm, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(25)), ierr)
           enddo
         endif

         coordn(1)=coords(1)-1
         coordn(2)=coords(2)-1
         coordn(3)=coords(3)-1
         ansar(26)=MPA_BCHK(isperiodic1,dims,coordn,coords,nxsh,nysh,nzsh) 
         if (ansar(26)) then
           tag = identif
           call MPI_CART_RANK(comm3d, coordn, rrank, ierr)
           do i = 1, maxshift
             lbuf=maxshift*maxshift*maxshift
             call MPI_SEND_INIT(xmymzm, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_send(i,26), ierr)
             call MPI_RECV_INIT(rxpypzp, lbuf, MPI_DOUBLE_PRECISION, &
             & rrank, tag, comm3d, request_recv(i,req_recv_num(26)), ierr)
           enddo
         endif

       endif
      !write(*,*)'exch rank',myrank,'coords',coords,ans,coordn

!      lbuf=(nze-nzi+1)*(nye-nyi+1)*nxsh

      if (prplc(1) == 1) then

        if (ansar(1)) then
          ibuf = 0
          do k = nzi, nze
          do j = nyi, nye
          do is = 1, nxsh
            ibuf = ibuf + 1
            xpy0z0(ibuf) = x(nxe-is+1,j,k)
          end do
          end do
          end do

          ireq = ireq + 1
          req(ireq,identif) = request_send(nxsh,1)
          call MPI_START(request_send(nxsh,1), ierr)

        endif

!       CALL MPI_isend(xpy0z0,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)

!c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

        if (ansar(req_recv_num(1)) ) then

          ireq = ireq + 1
          req(ireq,identif) = request_recv(nxsh,1)
          call MPI_START(request_recv(nxsh,1), ierr)

!        call MPI_irecv(rxpy0z0,lbuf,MPI_DOUBLE_PRECISION,
!     &                rrank,tag,comm3d,
!     &                req(ireq,identif),ierr)

        end if

      end if

!c----------------------------------------------------------------
      if (prplc(2) == 1) then

        if (ansar(2)) then
          ibuf = 0
          do k = nzi, nze
          do j = nyi, nye
          do is = 1, nxsh
            ibuf = ibuf + 1
            xmy0z0(ibuf) = x(nxi-1+is,j,k)
          end do
          end do
          end do

          ireq = ireq + 1
          req(ireq,identif) = request_send(nxsh,2)
          call MPI_START(request_send(nxsh,2), ierr)

!          CALL MPI_isend(xmy0z0,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!          &             comm3d,req(ireq,identif),ierr)
        end if
!c----------------------------------------------------------------


        if (ansar(req_recv_num(2)) ) then

          ireq = ireq + 1
          req(ireq,identif) = request_recv(nxsh,2)
          call MPI_START(request_recv(nxsh,2), ierr)

!        call MPI_irecv(rxmy0z0,lbuf,MPI_DOUBLE_PRECISION,
!     &                 rrank,tag,comm3d,
!     &                 req(ireq,identif),ierr)
        end if

      end if

!c******************************************************************
!c      y-shift send

!       lbuf=(nze-nzi+1)*(nxe-nxi+1)*nysh

!c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

      if (prplc(3) == 1)then

        if (ansar(3)) then
          ibuf = 0
          do k = nzi, nze
          do js = 1, nysh
          do i = nxi, nxe
            ibuf = ibuf + 1
            x0ypz0(ibuf) = x(i,nye-js+1,k)
          end do
          end do
          end do

          ireq = ireq + 1
          req(ireq,identif) = request_send(nysh,3)
          call MPI_START(request_send(nysh,3), ierr)
        endif

        !write(ifn,*)'sendp3',myrank,rrank,tag,lbuf,ireq
!       CALL MPI_isend(x0ypz0,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)
!c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

        if (ansar(req_recv_num(3))) then

          ireq = ireq + 1
          req(ireq,identif) = request_recv(nysh,3)
          call MPI_START(request_recv(nysh,3), ierr)
!        call MPI_irecv(rx0ypz0,lbuf,MPI_DOUBLE_PRECISION,
!     &                 rrank,tag,comm3d,
!     &                 req(ireq,identif),ierr)
!        irx0ypz0=ireq
        end if

      end if

!c----------------------------------------------------------------
      if (prplc(4) == 1) then

        if (ansar(4)) then
          ibuf = 0
          do k = nzi, nze
          do js = 1, nysh
          do i = nxi, nxe
           ibuf = ibuf + 1
           x0ymz0(ibuf) = x(i,nyi+js-1,k)
          end do
          end do
          end do

          ireq = ireq + 1
          req(ireq,identif) = request_send(nysh,4)
          call MPI_START(request_send(nysh,4), ierr)
        endif

!       CALL MPI_isend(x0ymz0,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)


        if (ansar(req_recv_num(4)) ) then

          ireq = ireq + 1
          req(ireq,identif) = request_recv(nysh,4)
          call MPI_START(request_recv(nysh,4), ierr)

        endif

!         call MPI_irecv(rx0ymz0,lbuf,MPI_DOUBLE_PRECISION,
!      &                 rrank,tag,comm3d,
!      &                 req(ireq,identif),ierr)

      end if
!******************************************************************
!      z-shift send
!      lbuf=(nye-nyi+1)*(nxe-nxi+1)*nzsh
!c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

      if (prplc(5) == 1) then

        if (ansar(5)) then
          ibuf = 0
          do ks = 1, nzsh
          do j = nyi, nye
          do i = nxi, nxe
            ibuf = ibuf + 1
            x0y0zp(ibuf) = x(i,j,nze-ks+1)
          end do
          end do
          end do
          ireq = ireq + 1
          req(ireq,identif) = request_send(nzsh,5)
          call MPI_START(request_send(nzsh,5), ierr)
        endif
!       CALL MPI_isend(x0y0zp,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)

        if ( ansar(req_recv_num(5)) ) then
          ireq = ireq + 1
          req(ireq,identif) = request_recv(nzsh,5)
          call MPI_START(request_recv(nzsh,5), ierr)
        endif
       !write(ifn,*)'recvp5',myrank,rrank,tag,lbuf
!        call MPI_irecv(rx0y0zp,lbuf,MPI_DOUBLE_PRECISION,
!     &                 rrank,tag,comm3d,
!     &                 req(ireq,identif),ierr)

      end if
!c-------------------------------------------------------------------
      if (prplc(6) == 1) then

        if (ansar(6)) then
          ibuf = 0
          do ks = 1, nzsh
          do j = nyi, nye
          do i = nxi, nxe
           ibuf = ibuf + 1
           x0y0zm(ibuf) = x(i,j,nzi+ks-1)
          end do
          end do
          end do
          ireq = ireq + 1
          req(ireq,identif) = request_send(nzsh,6)
          call MPI_START(request_send(nzsh,6), ierr)
        endif
        if (ansar(req_recv_num(6)) ) then
          ireq = ireq + 1
          req(ireq,identif) = request_recv(nzsh,6)
          call MPI_START(request_recv(nzsh,6), ierr)
!        call MPI_irecv(rx0y0zm,lbuf,MPI_DOUBLE_PRECISION,
!     &                 rrank,tag,comm3d,
!     &                 req(ireq,identif),ierr)
        end if

!       CALL MPI_isend(x0y0zm,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)

      end if
!c      xy-shift send

!       lbuf=(nze-nzi+1)*nysh*nxsh
!c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      if (prplc(7) == 1) then

        if (ansar(7)) then
          ibuf = 0
          do k = nzi, nze
          do js = 1, nysh
          do is = 1, nxsh
            ibuf = ibuf + 1
            xpypz0(ibuf) = x(nxe-is+1,nye-js+1,k)
          end do
          end do
          end do
          ireq = ireq + 1
          req(ireq,identif) = request_send(1,7)
          call MPI_START(request_send(1,7), ierr)
!       CALL MPI_isend(xpypz0,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)
        endif

!c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

        if (ansar(req_recv_num(7)) ) then
          ireq = ireq + 1
          req(ireq,identif) = request_recv(1,7)
          call MPI_START(request_recv(1,7), ierr)
!      call MPI_irecv(rxpypz0,lbuf,MPI_DOUBLE_PRECISION,
!     &               rrank,tag,comm3d,
!     &               req(ireq,identif),ierr)
        end if

      end if
!c----------------------------------------------------------------
!c
!c+++++++++++++++++++++++++++++-----------------------------------

      if (prplc(8) == 1) then

        if (ansar(8)) then
          ibuf = 0
          do k = nzi, nze
          do js = 1, nysh
          do is = 1, nxsh
           ibuf = ibuf + 1
           xpymz0(ibuf) = x(nxe-is+1,nyi+js-1,k)
          end do
          end do
          end do
          ireq = ireq + 1
          req(ireq,identif) = request_send(1,8)
          call MPI_START(request_send(1,8), ierr)
!       CALL MPI_isend(xpymz0,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)
        end if
!c++++++++++++++++++++++-----------------------------------------

        if (ansar(req_recv_num(8)) ) then
          ireq = ireq + 1
          req(ireq,identif) = request_recv(1,8)
          call MPI_START(request_recv(1,8), ierr)
!      call MPI_irecv(rxpymz0,lbuf,MPI_DOUBLE_PRECISION,
!     &               rrank,tag,comm3d,
!     &               req(ireq,identif),ierr)
        end if

      end if
!c----------------------------------------------------------------
!c-----------------------------+++++++++++++++++++++++++++++++++++

      if (prplc(9) == 1) then

        if (ansar(9)) then
          ibuf = 0
          do k = nzi, nze
          do js = 1, nysh
          do is = 1, nxsh
            ibuf = ibuf + 1
            xmypz0(ibuf) = x(nxi+is-1,nye-js+1,k)
          end do
          end do
          end do
          ireq = ireq + 1
          req(ireq,identif) = request_send(1,9)
          call MPI_START(request_send(1,9), ierr)
!       CALL MPI_isend(xmypz0,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)
        end if

        if (ansar(req_recv_num(9)) ) then
          ireq = ireq + 1
          req(ireq,identif) = request_recv(1,9)
          call MPI_START(request_recv(1,9), ierr)
!      call MPI_irecv(rxmypz0,lbuf,MPI_DOUBLE_PRECISION,
!     &               rrank,tag,comm3d,
!     &               req(ireq,identif),ierr)

        end if

      end if
!c----------------------------------------------------------------
!c-----------------------------    ------------------------------

      if (prplc(10) == 1) then

        if (ansar(10)) then
          ibuf = 0
          do k = nzi, nze
          do js = 1, nysh
          do is = 1, nxsh
            ibuf = ibuf + 1
            xmymz0(ibuf) = x(nxi+is-1,nyi+js-1,k)
          end do
          end do
          end do
          ireq = ireq + 1
          req(ireq,identif) = request_send(1,10)
          call MPI_START(request_send(1,10), ierr)
!       CALL MPI_isend(xmymz0,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)
        end if

        if (ansar(req_recv_num(10)) ) then
          ireq = ireq + 1
          req(ireq,identif) = request_recv(1,10)
          call MPI_START(request_recv(1,10), ierr)

!      call MPI_irecv(rxmymz0,lbuf,MPI_DOUBLE_PRECISION,
!     &                rrank,tag,comm3d,
!     &                req(ireq,identif),ierr)
        end if

      end if
!c----------------------------------------------------------------
!c
!c      xz-shift send
!c
!       lbuf=(nye-nyi+1)*nzsh*nxsh
!c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

      if (prplc(11) == 1) then

        if (ansar(11)) then
          ibuf = 0
          do ks = 1, nzsh
          do j = nyi, nye
          do is = 1, nxsh
           ibuf = ibuf + 1
           xpy0zp(ibuf) = x(nxe-is+1,j,nze-ks+1)
          end do
          end do
          end do
          ireq = ireq + 1
          req(ireq,identif) = request_send(1,11)
          call MPI_START(request_send(1,11), ierr)
!       CALL MPI_isend(xpy0zp,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)
        end if

        if (ansar(req_recv_num(11))) then
          ireq = ireq + 1
          req(ireq,identif) = request_recv(1,11)
          call MPI_START(request_recv(1,11), ierr)
!      call MPI_irecv(rxpy0zp,lbuf,MPI_DOUBLE_PRECISION,
!     &                rrank,tag,comm3d,
!     &                req(ireq,identif),ierr)
        end if

      end if
!c----------------------------------------------------------------
!c
!c+++++++++++++++++++++++++++++-----------------------------------

      if (prplc(12) == 1) then

        if (ansar(12)) then
          ibuf = 0
          do ks = 1, nzsh
          do j = nyi, nye
          do is = 1, nxsh
            ibuf = ibuf + 1
            xpy0zm(ibuf) = x(nxe-is+1,j,nzi+ks-1)
          end do
          end do
          end do
          ireq = ireq + 1
          req(ireq,identif) = request_send(1,12)
          call MPI_START(request_send(1,12), ierr)
!       CALL MPI_isend(xpy0zm,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)
        end if

        if (ansar(req_recv_num(12)) ) then
          ireq = ireq + 1
          req(ireq,identif) = request_recv(1,12)
          call MPI_START(request_recv(1,12), ierr)
!      call MPI_irecv(rxpy0zm,lbuf,MPI_DOUBLE_PRECISION,
!     &               rrank,tag,comm3d,
!     &                req(ireq,identif),ierr)
        end if

      end if
!c----------------------------------------------------------------
!c-----------------------------+++++++++++++++++++++++++++++++++++

      if (prplc(13) == 1) then

        if (ansar(13)) then
          ibuf = 0
          do ks = 1, nzsh
          do j = nyi, nye
          do is = 1, nxsh
           ibuf = ibuf + 1
           xmy0zp(ibuf) = x(nxi+is-1,j,nze-ks+1)
          end do
          end do
          end do
          ireq = ireq + 1
          req(ireq,identif) = request_send(1,13)
          call MPI_START(request_send(1,13), ierr)
!       CALL MPI_isend(xmy0zp,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)
        end if

        if (ansar(req_recv_num(13)) ) then
          ireq = ireq + 1
          req(ireq,identif) = request_recv(1,13)
          call MPI_START(request_recv(1,13), ierr)
!      call MPI_irecv(rxmy0zp,lbuf,MPI_DOUBLE_PRECISION,
!     &                rrank,tag,comm3d,
!     &                req(ireq,identif),ierr)
        end if

      end if
!c----------------------------------------------------------------
!c-----------------------------    ------------------------------

      if (prplc(14) == 1) then

        if (ansar(14)) then
          ibuf = 0
          do ks = 1, nzsh
          do j = nyi, nye
          do is = 1, nxsh
           ibuf = ibuf + 1
           xmy0zm(ibuf) = x(nxi+is-1,j,nzi+ks-1)
          end do
          end do
          end do
          ireq = ireq + 1
          req(ireq,identif) = request_send(1,14)
          call MPI_START(request_send(1,14), ierr)
!       CALL MPI_isend(xmy0zm,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)
        end if

        if (ansar(req_recv_num(14)) ) then
          ireq = ireq + 1
          req(ireq,identif) = request_recv(1,14)
          call MPI_START(request_recv(1,14), ierr)
!      call MPI_irecv(rxmy0zm,lbuf,MPI_DOUBLE_PRECISION,
!     &               rrank,tag,comm3d,
!     &               req(ireq,identif),ierr)
        end if

      end if
!c----------------------------------------------------------------
!c----------------------------------------------------------------
!c
!c      yz-shift send
!c
!       lbuf=(nxe-nxi+1)*nzsh*nysh
!c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

      if (prplc(15) == 1) then

        if (ansar(15)) then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do i = nxi, nxe
            ibuf = ibuf + 1
            x0ypzp(ibuf) = x(i,nye-js+1,nze-ks+1)
          end do
          end do
          end do
          ireq = ireq + 1
          req(ireq,identif) = request_send(1,15)
          call MPI_START(request_send(1,15), ierr)
!       CALL MPI_isend(x0ypzp,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)
        end if

        if (ansar(req_recv_num(15)) ) then
          ireq = ireq + 1
          req(ireq,identif) = request_recv(1,15)
          call MPI_START(request_recv(1,15), ierr)
!      call MPI_irecv(rx0ypzp,lbuf,MPI_DOUBLE_PRECISION,
!     &                rrank,tag,comm3d,
!     &                req(ireq,identif),ierr)
        end if

      end if
!c----------------------------------------------------------------
!c
!c+++++++++++++++++++++++++++++-----------------------------------

      if (prplc(16) == 1) then

        if (ansar(16)) then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do i = nxi, nxe
            ibuf = ibuf + 1
            x0ypzm(ibuf) = x(i,nye-js+1,nzi+ks-1)
          end do
          end do
          end do
          ireq = ireq + 1
          req(ireq,identif) = request_send(1,16)
          call MPI_START(request_send(1,16), ierr)
!       CALL MPI_isend(x0ypzm,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)
        end if

        if (ansar(req_recv_num(16)) ) then
          ireq = ireq + 1
          req(ireq,identif) = request_recv(1,16)
          call MPI_START(request_recv(1,16), ierr)
!      call MPI_irecv(rx0ypzm,lbuf,MPI_DOUBLE_PRECISION,
!     &                rrank,tag,comm3d,
!     &                req(ireq,identif),ierr)
        end if

      end if

!c----------------------------------------------------------------
!c-----------------------------+++++++++++++++++++++++++++++++++++
      if (prplc(17) == 1) then

        if (ansar(17)) then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do i = nxi, nxe
           ibuf = ibuf + 1
           x0ymzp(ibuf) = x(i,nyi+js-1,nze-ks+1)
          end do
          end do
          end do
          ireq = ireq + 1
          req(ireq,identif) = request_send(1,17)
          call MPI_START(request_send(1,17), ierr)
!       CALL MPI_isend(x0ymzp,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)
        end if

        if (ansar(req_recv_num(17)) ) then
          ireq = ireq + 1
          req(ireq,identif) = request_recv(1,17)
          call MPI_START(request_recv(1,17), ierr)
!      call MPI_irecv(rx0ymzp,lbuf,MPI_DOUBLE_PRECISION,
!     &               rrank,tag,comm3d,
!     &               req(ireq,identif),ierr)
        end if

      end if
!c----------------------------------------------------------------
!c-----------------------------    ------------------------------

      if (prplc(18) == 1) then

        if (ansar(18)) then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do i = nxi, nxe
           ibuf = ibuf + 1
           x0ymzm(ibuf) = x(i,nyi+js-1,nzi+ks-1)
          end do
          end do
          end do
          ireq = ireq + 1
          req(ireq,identif) = request_send(1,18)
          call MPI_START(request_send(1,18), ierr)
!       CALL MPI_isend(x0ymzm,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)
        end if

        if (ansar(req_recv_num(18)) ) then
          ireq = ireq + 1
          req(ireq,identif) = request_recv(1,18)
          call MPI_START(request_recv(1,18), ierr)
!      call MPI_irecv(rx0ymzm,lbuf,MPI_DOUBLE_PRECISION,
!     &                rrank,tag,comm3d,
!     &                req(ireq,identif),ierr)
        end if

      end if


!c      !write(*,*)'sent lines',myrank,ireq
!c-------------- xyz-------------shift--------------------------
!       lbuf=nxsh*nzsh*nysh
!c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

      if (prplc(19) == 1) then

        if (ansar(19)) then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do is = 1, nxsh
            ibuf = ibuf + 1
            xpypzp(ibuf) = x(nxe-is+1,nye-js+1,nze-ks+1)
          end do
          end do
          end do
          ireq = ireq + 1
          req(ireq,identif) = request_send(1,19)
          call MPI_START(request_send(1,19), ierr)
!       CALL MPI_isend(xpypzp,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)
        end if

        if (ansar(req_recv_num(19)) ) then
          ireq = ireq + 1
          req(ireq,identif) = request_recv(1,19)
          call MPI_START(request_recv(1,19), ierr)
!      call MPI_irecv(rxpypzp,lbuf,MPI_DOUBLE_PRECISION,
!     &                rrank,tag,comm3d,
!     &                req(ireq,identif),ierr)
        end if

      end if


!c++++++ +++++++ ------

      if (prplc(20) == 1) then

        if (ansar(20)) then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do is = 1, nxsh
            ibuf = ibuf + 1
            xpypzm(ibuf) = x(nxe-is+1,nye-js+1,nzi+ks-1)
          end do
          end do
          end do
          ireq = ireq + 1
          req(ireq,identif) = request_send(1,20)
          call MPI_START(request_send(1,20), ierr)
!       CALL MPI_isend(xpypzm,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)
        end if

        if (ansar(req_recv_num(20)) ) then
          ireq = ireq + 1
          req(ireq,identif) = request_recv(1,20)
          call MPI_START(request_recv(1,20), ierr)
!      call MPI_irecv(rxpypzm,lbuf,MPI_DOUBLE_PRECISION,
!     &               rrank,tag,comm3d,
!     &               req(ireq,identif),ierr)
        end if

      end if

!c++++++ ------ ++++++

      if (prplc(21) == 1) then

        if (ansar(21)) then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do is = 1, nxsh
            ibuf = ibuf + 1
            xpymzp(ibuf) = x(nxe-is+1,nyi+js-1,nze-ks+1)
          end do
          end do
          end do
          ireq = ireq + 1
          req(ireq,identif) = request_send(1,21)
          call MPI_START(request_send(1,21), ierr)
!       CALL MPI_isend(xpymzp,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)
        end if

        if (ansar(req_recv_num(21)) ) then
          ireq = ireq + 1
          req(ireq,identif) = request_recv(1,21)
          call MPI_START(request_recv(1,21), ierr)
!      call MPI_irecv(rxpymzp,lbuf,MPI_DOUBLE_PRECISION,
!     &               rrank,tag,comm3d,
!     &               req(ireq,identif),ierr)
        end if

      end if


!c++++++ ------ -------

      if (prplc(22) == 1) then

        if (ansar(22)) then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do is = 1, nxsh
            ibuf = ibuf + 1
            xpymzm(ibuf) = x(nxe-is+1,nyi+js-1,nzi+ks-1)
          end do
          end do
          end do
          ireq = ireq + 1
          req(ireq,identif) = request_send(1,22)
          call MPI_START(request_send(1,22), ierr)
!       CALL MPI_isend(xpymzm,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)
        end if

        if (ansar(req_recv_num(22)) ) then
          ireq = ireq + 1
          req(ireq,identif) = request_recv(1,22)
          call MPI_START(request_recv(1,22), ierr)
!      call MPI_irecv(rxpymzm,lbuf,MPI_DOUBLE_PRECISION,
!     &               rrank,tag,comm3d,
!     &               req(ireq,identif),ierr)
        end if

      end if


!c------     +++++++++   ++++++

      if (prplc(23) == 1) then

        if (ansar(23)) then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do is = 1, nxsh
            ibuf = ibuf + 1
            xmypzp(ibuf) = x(nxi+is-1,nye-js+1,nze-ks+1)
          end do
          end do
          end do
          ireq = ireq + 1
          req(ireq,identif) = request_send(1,23)
          call MPI_START(request_send(1,23), ierr)
!       CALL MPI_isend(xmypzp,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)
        end if

        if (ansar(req_recv_num(23)) ) then
          ireq = ireq + 1
          req(ireq,identif) = request_recv(1,23)
          call MPI_START(request_recv(1,23), ierr)
!      call MPI_irecv(rxmypzp,lbuf,MPI_DOUBLE_PRECISION,
!     &                rrank,tag,comm3d,
!     &                req(ireq,identif),ierr)
        end if

      end if


!c------ +++++++ ------

      if (prplc(24) == 1) then

        if (ansar(24)) then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do is = 1, nxsh
            ibuf = ibuf + 1
            xmypzm(ibuf) = x(nxi+is-1,nye-js+1,nzi+ks-1)
          end do
          end do
          end do
          ireq = ireq + 1
          req(ireq,identif) = request_send(1,24)
          call MPI_START(request_send(1,24), ierr)
!       CALL MPI_isend(xmypzm,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)
        end if

        if (ansar(req_recv_num(24)) ) then
          ireq = ireq + 1
          req(ireq,identif) = request_recv(1,24)
          call MPI_START(request_recv(1,24), ierr)
!      call MPI_irecv(rxmypzm,lbuf,MPI_DOUBLE_PRECISION,
!     &               rrank,tag,comm3d,
!     &               req(ireq,identif),ierr)
        end if

      end if

!c------ ------ ++++++

      if (prplc(25) == 1) then

        if (ansar(25)) then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do is = 1, nxsh
            ibuf = ibuf + 1
            xmymzp(ibuf) = x(nxi+is-1,nyi+js-1,nze-ks+1)
          end do
          end do
          end do
          ireq = ireq + 1
          req(ireq,identif) = request_send(1,25)
          call MPI_START(request_send(1,25), ierr)
!       CALL MPI_isend(xmymzp,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)
        end if

        if (ansar(req_recv_num(25)) ) then
          ireq = ireq + 1
          req(ireq,identif) = request_recv(1,25)
          call MPI_START(request_recv(1,25), ierr)
!      call MPI_irecv(rxmymzp,lbuf,MPI_DOUBLE_PRECISION,
!     &               rrank,tag,comm3d,
!     &               req(ireq,identif),ierr)
        end if

      end if


!c----- ------ -------

      if (prplc(26) == 1) then

        if (ansar(26)) then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do is = 1, nxsh
            ibuf = ibuf + 1
            xmymzm(ibuf) = x(nxi+is-1,nyi+js-1,nzi+ks-1)
          end do
          end do
          end do
          ireq = ireq + 1
          req(ireq,identif) = request_send(1,26)
          call MPI_START(request_send(1,26), ierr)
!       CALL MPI_isend(xmymzm,lbuf,MPI_DOUBLE_PRECISION,rrank,tag,
!     &                comm3d,req(ireq,identif),ierr)
        end if

        if (ansar(req_recv_num(26)) ) then
          ireq = ireq + 1
          req(ireq,identif) = request_recv(1,26)
          call MPI_START(request_recv(1,26), ierr)
!      call MPI_irecv(rxmymzm,lbuf,MPI_DOUBLE_PRECISION,
!     &               rrank,tag,comm3d,
!     &               req(ireq,identif),ierr)
        end if

      end if

      do i = 1, ireq
        call MPI_WAIT(req(i,identif), status1, ierr)
      enddo


!C*******************************************************************

      if (prplc(1) == 1) then
        if (ansar(req_recv_num(1))) then
          ibuf = 0
          do k = nzi, nze
          do j = nyi, nye
          do is = 1, nxsh
            ibuf = ibuf + 1
            x(nxi-is,j,k) = rxpy0z0(ibuf)
          end do
          end do
          end do
        end if
      end if

      if (prplc(2) == 1) then
        if (ansar(req_recv_num(2))) then
          ibuf = 0
          do k = nzi, nze
          do j = nyi, nye
          do is = 1, nxsh
            ibuf = ibuf + 1
            x(nxe+is,j,k) = rxmy0z0(ibuf)
          end do
          end do
          end do
        end if
      end if

      if (prplc(3) == 1) then
        if (ansar(req_recv_num(3))) then
          ibuf = 0
          do k = nzi, nze
          do js = 1, nysh
          do i = nxi, nxe
            ibuf = ibuf + 1
            x(i,nyi-js,k) = rx0ypz0(ibuf)
          end do
          end do
          end do
        end if
      end if

      if (prplc(4) == 1) then
        if (ansar(req_recv_num(4)) ) then
          ibuf = 0
          do k = nzi, nze
          do js = 1, nysh
          do i = nxi, nxe
            ibuf = ibuf + 1
            x(i,nye+js,k) = rx0ymz0(ibuf)
          end do
          end do
          end do
        end if
      end if

      if (prplc(5) == 1) then
        if (ansar(req_recv_num(5))) then
          ibuf = 0
          do ks = 1, nzsh
          do j = nyi, nye
          do i = nxi, nxe
            ibuf = ibuf + 1
            x(i,j,nzi-ks) = rx0y0zp(ibuf)
          end do
          end do
          end do
        end if
      end if

      if (prplc(6) == 1) then
        if (ansar(req_recv_num(6))) then
          ibuf = 0
          do ks = 1, nzsh
          do j = nyi, nye
          do i = nxi, nxe
            ibuf = ibuf + 1
            x(i,j,nze+ks) = rx0y0zm(ibuf)
          end do
          end do
          end do
        end if
      end if

!c--------xy------------xy-------------xy-------------xy-------------
!c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

      if (prplc(7) == 1) then
        if (ansar(req_recv_num(7))) then
          ibuf = 0
          do k = nzi, nze
          do js = 1, nysh
          do is = 1, nxsh
            ibuf = ibuf + 1
            x(nxi-is,nyi-js,k) = rxpypz0(ibuf)
          end do
          end do
          end do
        end if
      end if

!c++++++++++++++++++++++++++++++--------------------------------------

      if (prplc(8) == 1) then
        if (ansar(req_recv_num(8))) then
          ibuf = 0
          do k = nzi, nze
          do js = 1, nysh
          do is = 1, nxsh
           ibuf = ibuf + 1
           x(nxi-is,nye+js,k) = rxpymz0(ibuf)
          end do
          end do
          end do
        end if
      end if

!c---------------------------------++++++++++++++++++++++++++++++++++

      if (prplc(9) == 1) then
        if (ansar(req_recv_num(9))) then
          ibuf = 0
          do k = nzi, nze
          do js = 1, nysh
          do is = 1, nxsh
           ibuf = ibuf + 1
           x(nxe+is,nyi-js,k) = rxmypz0(ibuf)
          end do
          end do
          end do
        end if
      end if
!c---------------------------------   --------------------------------

      if (prplc(10) == 1) then
        if (ansar(req_recv_num(10))) then
          ibuf = 0
          do k = nzi, nze
          do js = 1, nysh
          do is = 1, nxsh
            ibuf = ibuf + 1
            x(nxe+is,nye+js,k) = rxmymz0(ibuf)
          end do
          end do
          end do
        end if
      end if

!c--------xz------------xz-------------xz-------------xz-------------
!c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

      if (prplc(11) == 1) then
        if(ansar(req_recv_num(11)))then
          ibuf = 0
          do ks = 1, nzsh
          do j = nyi, nye
          do is = 1, nxsh
            ibuf = ibuf + 1
            x(nxi-is,j,nzi-ks) = rxpy0zp(ibuf)
          end do
          end do
          end do
        end if
      end if
!c++++++++++++++++++++++++++++++--------------------------------------

      if (prplc(12) == 1) then
        if (ansar(req_recv_num(12))) then
          ibuf = 0
          do ks = 1, nzsh
          do j = nyi, nye
          do is = 1, nxsh
            ibuf = ibuf + 1
            x(nxi-is,j,nze+ks) = rxpy0zm(ibuf)
          end do
          end do
          end do
        end if
      end if
!c---------------------------------++++++++++++++++++++++++++++++++++

      if (prplc(13) == 1) then
        if (ansar(req_recv_num(13))) then
          ibuf = 0
          do ks = 1, nzsh
          do j = nyi, nye
          do is = 1, nxsh
            ibuf = ibuf + 1
            x(nxe+is,j,nzi-ks) = rxmy0zp(ibuf)
          end do
          end do
          end do
        end if
      end if
!c---------------------------------   --------------------------------

      if (prplc(14) == 1) then
        if(ansar(req_recv_num(14)))then
          ibuf = 0
          do ks = 1, nzsh
          do j = nyi, nye
          do is = 1, nxsh
            ibuf = ibuf + 1
            x(nxe+is,j,nze+ks) = rxmy0zm(ibuf)
          end do
          end do
          end do
        end if
      end if

!c--------yz------------yz-------------yz-------------yz-------------
!c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

      if (prplc(15) == 1) then
        if(ansar(req_recv_num(15)))then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do i = nxi, nxe
            ibuf = ibuf + 1
            x(i,nyi-js,nzi-ks) = rx0ypzp(ibuf)
          end do
          end do
          end do
        end if
      end if
!c++++++++++++++++++++++++++++++--------------------------------------

      if (prplc(16) == 1) then
        if(ansar(req_recv_num(16)))then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do i = nxi, nxe
           ibuf = ibuf + 1
           x(i,nyi-js,nze+ks) = rx0ypzm(ibuf)
          end do
          end do
          end do
        end if
      end if
!c---------------------------------++++++++++++++++++++++++++++++++++

      if (prplc(17) == 1) then
        if (ansar(req_recv_num(17))) then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do i = nxi, nxe
            ibuf = ibuf + 1
            x(i,nye+js,nzi-ks) = rx0ymzp(ibuf)
          end do
          end do
          end do
        end if
      end if
!c---------------------------------   --------------------------------

      if (prplc(18) == 1) then
        if (ansar(req_recv_num(18))) then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do i = nxi, nxe
            ibuf = ibuf + 1
            x(i,nye+js,nze+ks) = rx0ymzm(ibuf)
          end do
          end do
          end do
        end if
      end if

!c--------xyz------------xyz-------------xyz-------------xyz---------
!c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

      if (prplc(19) == 1) then
        if (ansar(req_recv_num(19))) then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do is = 1, nxsh
            ibuf = ibuf + 1
            x(nxi-is,nyi-js,nzi-ks) = rxpypzp(ibuf)
          end do
          end do
          end do
        end if
      end if
!c ++++++ +++++++ --------

      if (prplc(20) == 1) then
        if (ansar(req_recv_num(20))) then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do is = 1, nxsh
           ibuf = ibuf + 1
           x(nxi-is,nyi-js,nze+ks) = rxpypzm(ibuf)
          end do
          end do
          end do
        end if
      end if

!c ++++++ ------- +++++++\

      if (prplc(21) == 1) then
        if (ansar(req_recv_num(21))) then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do is = 1, nxsh
            ibuf = ibuf + 1
            x(nxi-is,nye+js,nzi-ks) = rxpymzp(ibuf)
          end do
          end do
          end do
        end if
      end if

!cc ++++++ ------- --------

      if (prplc(22) == 1) then
        if (ansar(req_recv_num(22))) then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do is = 1, nxsh
           ibuf = ibuf + 1
           x(nxi-is,nye+js,nze+ks) = rxpymzm(ibuf)
          end do
          end do
          end do
        end if
      end if

!c------     ++++++++   +++++++

      if (prplc(23) == 1) then
        if (ansar(req_recv_num(23))) then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do is = 1, nxsh
            ibuf = ibuf + 1
            x(nxe+is,nyi-js,nzi-ks) = rxmypzp(ibuf)
          end do
          end do
          end do
        end if
      end if

!c ++++++ +++++++ --------

      if (prplc(24) == 1) then
        if (ansar(req_recv_num(24))) then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do is = 1, nxsh
            ibuf = ibuf + 1
            x(nxe+is,nyi-js,nze+ks) = rxmypzm(ibuf)
          end do
          end do
          end do
        end if
      end if

!c ------- ------- +++++++

      if (prplc(25) == 1) then
        if (ansar(req_recv_num(25))) then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do is = 1, nxsh
            ibuf = ibuf + 1
            x(nxe+is,nye+js,nzi-ks) = rxmymzp(ibuf)
          end do
          end do
          end do
        end if
      end if

!cc -------- ------- --------

      if (prplc(26) == 1) then
        if (ansar(req_recv_num(26))) then
          ibuf = 0
          do ks = 1, nzsh
          do js = 1, nysh
          do is = 1, nxsh
           ibuf = ibuf + 1
           x(nxe+is,nye+js,nze+ks) = rxmymzm(ibuf)
          end do
          end do
          end do
        end if
      end if

!c      call MPI_BARRIER(comm3d,ierr)
!c        write(*,*)'exch out',identif,' rank ',myrank

!               deallocate (rxmymzm)
!               deallocate (rxmypzm)
!               deallocate (rxmymzp)
!               deallocate (rxmypzp)
!       deallocate (rxpymzm)
!       deallocate (rxpypzm)
!       deallocate (rxpymzp)
!       deallocate (rxpypzp)
!               deallocate (rx0ymzm)
!               deallocate (rx0ymzp)
!               deallocate (rx0ypzm)
!               deallocate (rx0ypzp)
!        deallocate (rxmy0zm)
!        deallocate (rxmy0zp)
!        deallocate (rxpy0zm)
!        deallocate (rxpy0zp)
!                deallocate (rxmymz0)
!                deallocate (rxpymz0)
!                deallocate (rxmypz0)
!                deallocate (rxpypz0)
!        deallocate(rx0y0zm)
!        deallocate(rx0y0zp)
!        deallocate(rx0ymz0)
!        deallocate(rx0ypz0)
!        deallocate(rxmy0z0)
!        deallocate(rxpy0z0)
!               deallocate (xmymzm)
!               deallocate (xmypzm)
!               deallocate (xmymzp)
!               deallocate (xmypzp)
!       deallocate (xpymzm)
!       deallocate (xpypzm)
!       deallocate (xpymzp)
!       deallocate (xpypzp)
!               deallocate (x0ymzm)
!               deallocate (x0ymzp)
!               deallocate (x0ypzm)
!               deallocate (x0ypzp)
!        deallocate (xmy0zm)
!        deallocate (xmy0zp)
!        deallocate (xpy0zm)
!        deallocate (xpy0zp)
!                deallocate (xmymz0)
!                deallocate (xpymz0)
!                deallocate (xmypz0)
!                deallocate (xpypz0)
!        deallocate(x0y0zm)
!        deallocate(x0y0zp)
!        deallocate(x0ymz0)
!        deallocate(x0ypz0)
!        deallocate(xpy0z0)
!        deallocate(xmy0z0)

        if (firstcall) firstcall = .false.
        return
        END SUBROUTINE MPA_EXCH_NEW
!c**********************************************************************
